home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok12 / module / twofiles.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  173 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    TwoFiles.mod
  3.     :Author.     Bernd Preusing
  4.     :Address.    Gerhardstr. 16  D-2200 Elmshorn
  5.     :Phone.      04121/22486
  6.     :Shortcut.   [bep]
  7.     :Version.    1.1
  8.     :Date.       11-Nov-88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    InOut2 [bep]
  13.     :UpDate.     1.1: Added InMessage and OutMessage
  14.     :Contents.   Open Input and/or Output from commandline or Terminal
  15.     :Remark.
  16. ---------------------------------------------------------------------------*)
  17. IMPLEMENTATION MODULE TwoFiles;
  18.  
  19. FROM SYSTEM IMPORT
  20.     ADR;
  21.  
  22. FROM Arguments IMPORT
  23.     NumArgs, GetArg;
  24.  
  25. FROM Terminal IMPORT
  26.     ReadLn, Write, WriteString, WriteLn;
  27.  
  28. FROM InOut2 IMPORT
  29.     done, SetInput, SetOutput, CloseInput, CloseOutput;
  30.  
  31. FROM Dos IMPORT
  32.     FileLockPtr, oldFile, Lock, UnLock;
  33.  
  34. (* ============================================================
  35.  from Def-Module:
  36. TYPE
  37.     sFileName = ARRAY[0..79] OF CHAR;
  38.  
  39.     (* bekommt den '-'-Parameter incl. '-' *)
  40.     prOpt = PROCEDURE(VAR ARRAY OF CHAR);
  41.  
  42. VAR    (* nur zum Auslesen *)
  43.     InFileName, OutFileName: sFileName;
  44.  
  45.     (* zum Setzen der Msgs. Default: 'in>' und 'out>' *)
  46.     InMessage, OutMessage: sFileName;
  47. ============================================================ *)
  48.  
  49. CONST
  50.     msNotFound = ': nicht gefunden';
  51.     msNotOpen  = ': nicht zu öffnen';
  52.  
  53.  
  54. VAR
  55.     Args,
  56.     ActArg: INTEGER;
  57.     InterActive, Dir: BOOLEAN;
  58.     OptProc: prOpt;
  59.     Ask: BOOLEAN;
  60.  
  61.  
  62. PROCEDURE OptProcedure(p: prOpt);
  63. BEGIN
  64.   OptProc:=p
  65. END OptProcedure;
  66.  
  67. PROCEDURE SetAsk(ask: BOOLEAN);
  68. BEGIN
  69.   Ask:=ask
  70. END SetAsk;
  71.  
  72. (* $F- *)
  73.  
  74. PROCEDURE FileExists(VAR name: ARRAY OF CHAR): BOOLEAN;
  75. VAR lock: FileLockPtr;
  76. BEGIN
  77.   lock:=Lock(ADR(name),oldFile);
  78.   IF lock=NIL THEN
  79.     RETURN FALSE
  80.   ELSE
  81.     UnLock(lock);
  82.     RETURN TRUE
  83.   END
  84. END FileExists;
  85.  
  86. PROCEDURE GetName(VAR str, msg: sFileName; test: BOOLEAN): BOOLEAN;
  87. VAR len,dummy:INTEGER;
  88.     ok: BOOLEAN;
  89.     Answer: CHAR; line:ARRAY[0..0] OF CHAR; (* weil Read spinnt muß ReadLn! *)
  90. BEGIN
  91.   REPEAT
  92.     ok:=TRUE; Dir:=FALSE;
  93.     WriteString(msg);
  94.     IF InterActive THEN
  95.       ReadLn(str,len)
  96.     ELSE
  97.       GetArg(ActArg,str,len);
  98.       IF (len=0) AND (ActArg<=Args) THEN (* Workbench: Directory oder Device *)
  99.         str:='>DIRECTORY<';
  100.         Dir:=TRUE;
  101.         len:=11
  102.       END;
  103.       INC(ActArg);
  104.       WriteString(str); WriteLn
  105.     END;
  106.     IF (OptProc#NIL) AND (len>0) AND (str[0]='-') THEN
  107.       ok:=FALSE;
  108.       OptProc(str)
  109.     ELSIF test AND (len>0) AND FileExists(str) THEN
  110.       REPEAT
  111.         Write(07C); (* Beep *)
  112.         WriteString('Existiert bereits! Überschreiben (JY/N)?');
  113.         ReadLn(line,dummy); Answer:=CAP(line[0]);
  114.       UNTIL (Answer='J') OR (Answer='Y') OR (Answer='N');
  115.       ok:=(Answer#'N');
  116.       IF NOT ok THEN InterActive:= TRUE END; (* jetzt von Terminal *)
  117.     END;
  118.   UNTIL ok;
  119.   RETURN len>0
  120. END GetName;
  121.  
  122. PROCEDURE OpenFiles(in, out: BOOLEAN): BOOLEAN;
  123. BEGIN
  124.   IF in THEN
  125.     CloseInput;
  126.     REPEAT
  127.       IF NOT GetName(InFileName,InMessage,FALSE) THEN RETURN FALSE END;
  128.       SetInput(InFileName);
  129.       IF NOT done THEN
  130.         InterActive:=TRUE;
  131.         WriteString(InFileName); WriteString(msNotFound); WriteLn
  132.       END;
  133.     UNTIL done;
  134.   END;
  135.   IF out THEN
  136.     CloseOutput;
  137.     REPEAT
  138.       IF GetName(OutFileName,OutMessage,Ask) THEN
  139.         IF NOT Dir THEN
  140.           SetOutput(OutFileName); (* erzeugt sonst File >DIRECTORY< *)
  141.         ELSE
  142.           done:=FALSE (* nicht die feine Art, ich weiß *)
  143.         END;
  144.         IF NOT done THEN
  145.           InterActive:=TRUE;
  146.           WriteString(OutFileName); WriteString(msNotOpen); WriteLn
  147.         END;
  148.       ELSE (* name leer *)
  149.         IF in THEN (* 2.Para leer: gibt out nach Terminal *)
  150.       OutFileName:='*';
  151.           done:=TRUE (* nicht die feine Art, ich weiß *)
  152.     ELSE (* 1. Para leer: Ende *)
  153.       RETURN FALSE
  154.     END
  155.       END;
  156.     UNTIL done;
  157.   END;
  158.   RETURN TRUE
  159. END OpenFiles;
  160.  
  161.  
  162. BEGIN
  163.   Args:=NumArgs();
  164.   InterActive:=(Args=0);
  165.   ActArg:=1;
  166.   InFileName:='';
  167.   OutFileName:=InFileName;
  168.   InMessage:='in> ';
  169.   OutMessage:='out> ';
  170.   OptProc:=NIL;
  171.   Ask:=TRUE;
  172. END TwoFiles.mod
  173.